home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / languages / obrn-a_1.5_lib.lha / oberon-a / source2.lha / Source / Library / MathL.mod < prev    next >
Encoding:
Text File  |  1995-01-26  |  3.5 KB  |  173 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: MathL.mod $
  4.   Description: Basic functions for LONGREALs.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.3 $
  8.       $Author: fjc $
  9.         $Date: 1995/01/26 00:40:27 $
  10.  
  11.   Copyright © 1994-1995, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15.   Thanks to Mike Griebling and Rene Hogendoorn for their assistance.
  16.  
  17. *************************************************************************)
  18.  
  19. <* MAIN- *> <* INITIALISE- *> <*$LongVars+*> <*$ReturnChk-*>
  20.  
  21. MODULE MathL;
  22.  
  23. (*
  24.  
  25.   This module will not be implemented until the following two modules are
  26.   implemented.
  27.  
  28. IMPORT m1 := MathIeeeDoubBas, m2 := MathIeeeDoubTrans;
  29.  
  30. CONST
  31.   pi *= 3.14159265358979323846;
  32.   e  *= 2.71828182845904523536;
  33.  
  34.  
  35. PROCEDURE sqrt * ( x : LONGREAL ) : LONGREAL;
  36. BEGIN (* sqrt *)
  37.   RETURN m2.Sqrt (x)
  38. END sqrt;
  39.  
  40.  
  41. PROCEDURE power * ( x, base : LONGREAL ) : LONGREAL;
  42. BEGIN (* power *)
  43.   RETURN m2.Pow (base, x)
  44. END power;
  45.  
  46.  
  47. PROCEDURE exp * ( x : LONGREAL ) : LONGREAL;
  48. BEGIN (* exp *)
  49.   RETURN m2.Exp (x)
  50. END exp;
  51.  
  52.  
  53. PROCEDURE ln * ( x : LONGREAL ) : LONGREAL;
  54. BEGIN (* ln *)
  55.   RETURN m2.Log (x)
  56. END ln;
  57.  
  58.  
  59. PROCEDURE log * ( x, base : LONGREAL ) : LONGREAL;
  60. BEGIN (* log *)
  61.   RETURN m2.Log (x) / m2.Log (base)
  62. END log;
  63.  
  64.  
  65. PROCEDURE round * ( x : LONGREAL ) : LONGREAL;
  66. BEGIN (* round *)
  67.   IF x < 0.0 THEN RETURN m1.Ceil (x - 0.5)
  68.   ELSE RETURN m1.Floor (x + 0.5)
  69.   END
  70. END round;
  71.  
  72.  
  73. PROCEDURE sin * ( x : LONGREAL ) : LONGREAL;
  74. BEGIN (* sin *)
  75.   RETURN m2.Sin (x)
  76. END sin;
  77.  
  78.  
  79. PROCEDURE cos * ( x : LONGREAL ) : LONGREAL;
  80. BEGIN (* cos *)
  81.   RETURN m2.Cos (x)
  82. END cos;
  83.  
  84.  
  85. PROCEDURE tan * ( x : LONGREAL ) : LONGREAL;
  86. BEGIN (* tan *)
  87.   RETURN m2.Tan (x)
  88. END tan;
  89.  
  90.  
  91. PROCEDURE arcsin * ( x : LONGREAL ) : LONGREAL;
  92. BEGIN (* arcsin *)
  93.   RETURN m2.Asin (x)
  94. END arcsin;
  95.  
  96.  
  97. PROCEDURE arccos * ( x : LONGREAL ) : LONGREAL;
  98. BEGIN (* arccos *)
  99.   RETURN m2.Acos (x)
  100. END arccos;
  101.  
  102.  
  103. PROCEDURE arctan * ( x : LONGREAL ) : LONGREAL;
  104. BEGIN (* arctan *)
  105.   RETURN m2.Atan (x)
  106. END arctan;
  107.  
  108.  
  109. PROCEDURE arctan2 * ( xn, xd : LONGREAL ) : LONGREAL;
  110.  
  111.   CONST piBy2 = 1.57079632679489161923;
  112.   VAR res : LONGREAL;
  113.  
  114. BEGIN
  115.   IF xd = 0.0 THEN
  116.     IF xn = 0.0 THEN RETURN 0.0
  117.     ELSE IF xn < 0.0 THEN RETURN -piBy2 ELSE RETURN piBy2 END
  118.     END
  119.   (* Checking for Overflow/Underflow at this point appears unnecessary,
  120.      as testing without the checks seems to produce the correct results.
  121.      [Possibly 'famous last words' by fjc :-)]
  122.   ELSIF Overflow(xn/xd) THEN
  123.     IF xn < 0.0 THEN RETURN -piBy2 ELSE RETURN piBy2 END
  124.   ELSIF Underflow(xn/xd) THEN res := 0.0
  125.   *)
  126.   ELSE res := arctan(ABS(xn/xd))
  127.   END;
  128.   IF xd < 0.0 THEN res := pi - res END;
  129.   IF xn < 0.0 THEN RETURN -res ELSE RETURN res END
  130. END arctan2;
  131.  
  132.  
  133. PROCEDURE sinh * ( x : LONGREAL ) : LONGREAL;
  134. BEGIN (* sinh *)
  135.   RETURN m2.Sinh (x)
  136. END sinh;
  137.  
  138.  
  139. PROCEDURE cosh * ( x : LONGREAL ) : LONGREAL;
  140. BEGIN (* cosh *)
  141.   RETURN m2.Cosh (x)
  142. END cosh;
  143.  
  144.  
  145. PROCEDURE tanh * ( x : LONGREAL ) : LONGREAL;
  146. BEGIN (* tanh *)
  147.   RETURN m2.Tanh (x)
  148. END tanh;
  149.  
  150.  
  151. PROCEDURE arcsinh * ( x : LONGREAL ) : LONGREAL;
  152. BEGIN (* arcsinh *)
  153.   RETURN m2.Log (x + m2.Sqrt (x * x + 1.0))
  154. END arcsinh;
  155.  
  156.  
  157. PROCEDURE arccosh * ( x : LONGREAL ) : LONGREAL;
  158. BEGIN (* arccosh: x >= 1.0 *)
  159.   RETURN m2.Log (x + m2.Sqrt (x * x - 1.0))
  160. END arccosh;
  161.  
  162.  
  163. PROCEDURE arctanh * ( x : LONGREAL ) : LONGREAL;
  164. BEGIN (* arctanh: 0 <= x*x <= 1 *)
  165.   RETURN 0.5 * m2.Log ((1.0 + x) / (1.0 - x))
  166. END arctanh;
  167.  
  168.  
  169. BEGIN
  170.   ASSERT (m1.base # NIL, 100); ASSERT (m2.base # NIL, 100)
  171. *)
  172. END MathL.
  173.